;;;; -*- mode: Scheme; indent-tabs-mode: nil; fill-column: 80; -*-
;;;; 
;;;; Copyright © 2015 Rémi Delrue <asgeir@free.fr>
;;;; 
;;;; This program is free software: you can redistribute it and/or modify
;;;; it under the terms of the GNU General Public License as published by
;;;; the Free Software Foundation, either version 3 of the License, or
;;;; (at your option) any later version.
;;;; 
;;;; This program is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;;; GNU General Public License for more details.
;;;; 
;;;; You should have received a copy of the GNU General Public License
;;;; along with this program.  If not, see <http://www.gnu.org/licenses/>.

;; see comment (rehash fs)
(define-module (rehash common)
  #:use-module (system foreign)
  #:use-module (rnrs base)
  #:use-module (rnrs bytevectors)
  #:use-module (ice-9 match)
  #:use-module (rehash binding-utils)
  #:use-module (rehash config)
  #:export (gnunet-ok
            gnunet-system-error
            gnunet-yes
            gnunet-no
            bool->int
            int->bool

            time-relative
            time-absolute
            time-rel
            current-time
            time-absolute->string
            time-relative->absolute

            ecdsa-public-key
            ecdsa-public-key?
            eddsa-public-key
            eddsa-signature
            hashcode

            define-foreign-definer

            gnunet-util-ffi
            define-gnunet

            setup-log

            string->data-pointer))

(define (generate n x)
  "Generates a list of length N which elements are X."
  (if (zero? n)
      '()
      (cons x (generate (1- n) x))))

(define time-relative uint64)
(define time-absolute uint64)

(define %time-relative-forever #xffffffffffffffff) ; UINT64_MAX

(define ecdsa-public-key (generate (/ 256 8 4) uint32))
(define eddsa-public-key ecdsa-public-key)
(define eddsa-signature (list eddsa-public-key
                              eddsa-public-key))
(define hashcode (list (generate 16 uint32)))

(define (ecdsa-public-key? key)
  (and (string? key)
       (= (/ 258 8) (string-length key))))

(define gnunet-ok            1)
(define gnunet-system-error -1)
(define gnunet-yes           1)
(define gnunet-no            0)

(define gnunet-util-ffi     (dynamic-link %libgnunet-util))

(define-syntax define-foreign-definer
  (syntax-rules ()
    ((_ definer-name ffi-var)
     (define-syntax definer-name
       (syntax-rules (: ->)
         ((_ func name : in -> out)
          (define func
            (pointer->procedure out (dynamic-func name ffi-var) in))))))))

(define-foreign-definer define-gnunet    gnunet-util-ffi)
(define-foreign-definer define-gnunet-fs gnunet-fs-ffi)
(define-foreign-definer define-gnunet-id gnunet-identity-ffi)

(define-gnunet %time-absolute-get
  "GNUNET_TIME_absolute_get" : '() -> time-absolute)
(define-gnunet %time-absolute->string
  "GNUNET_STRINGS_absolute_time_to_string" : (list time-absolute) -> '*)
(define-gnunet %time-relative->absolute
  "GNUNET_TIME_relative_to_absolute" : (list time-relative) -> time-absolute)

(define-gnunet %log-setup "GNUNET_log_setup" : '(* * *) -> int)

(define (bool->int x) (if x gnunet-yes gnunet-no))
(define (int->bool x)
  (cond ((= gnunet-yes x)          #t)
        ((= gnunet-no x)           #f)
        ((= gnunet-system-error x) #:system-error)
        (else                      #:unknown)))

(define log-level-alist
  (list (cons #:none        (string->pointer "NONE"))
        (cons #:error       (string->pointer "ERROR"))
        (cons #:warning     (string->pointer "WARNING"))
        (cons #:info        (string->pointer "INFO"))
        (cons #:debug       (string->pointer "DEBUG"))
        (cons #:invalid     (string->pointer "INVALID"))
        (cons #:bulk        (string->pointer "BULK"))
        (cons #:unspecified (string->pointer "UNSPECIFIED"))))

(define* (setup-log client-name log-level #:optional (log-file ""))
  "Setup GNUnet’s logging. CLIENT-NAME is the name of the program you’re
writing, LOG-LEVEL is a keyword from (#:none #:error #:warning #:info #:debug
#:invalid #:bulk), LOG-FILE is either a filename or #f for `stderr'."
  (define (log-level->pointer key)
    (or (assq-ref log-level-alist key)
        (assq-ref log-level-alist #:unspecified)))
  (%log-setup (string->pointer client-name)
              (log-level->pointer log-level)
              (string->pointer* log-file)))

(define* (time-rel #:key (days 0) (hours 0) (minutes 0)
                   (seconds 0) (milli 0) (micro 0) #:rest rest)
  (match rest
    ((#:forever) %time-relative-forever)
    (_
     (let* ((hours*   (+ (* days     24)   hours))
            (minutes* (+ (* hours*    60)  minutes))
            (seconds* (+ (* minutes* 60)   seconds))
            (milli*   (+ (* seconds* 1000) milli))
            (micro*   (+ (* milli*   1000) micro)))
       (when (negative? micro*)
         (scm-error 'out-of-range "time-rel"
                    "result (~a) is negative" (list micro*)
                    (list hours minutes seconds milli micro)))
       (inexact->exact micro*)))))

(define (current-time)
  "Get the current time as an absolute time."
  (%time-absolute-get))

(define (time-absolute->string t)
  (pointer->string (%time-absolute->string t)))

(define (time-relative->absolute t)
  "Convert a relative time to an absolute time in the future."
  (%time-relative->absolute t))
